#!/usr/bin/perl

my $start = "(undefined)";
my $end = "(undefined)";
my $start_address = "(undefined)";
my $inside = 0;
my $start_time;
my $min_duration = 9999999;
my $max_duration = 1;
my $call_count = 0;
my $total_cycles = 0;
my $system_ready_time = 1;
my $simulation_end_time;
my $nested_subrs = 0;
my $list_subr = 0;
my $stop_after_one = 0;
my $irq_flag = 0;
my $named_start_address = undef;
my $mapfile= "build/freewpc.map";
my $histogram_flag = 0;
my $max_calls = 1000;
my $ignored_calls = 0;
my $compress_flag = 0;
my $decompress_flag = 0;

while ($_ = shift (@ARGV)) {
	if (/^-h$/) {
		print "Syntax: tracer [options] < tracefile\n";
		print "Options:\n";
		print "-m <file>        Use map <file> for symbolic information\n";
		print "-a <addr>        Analyze function beginning at <addr>\n";
		print "-l               List first instance of function then stop\n";
		print "--list-all       List all instances found\n";
		print "-1               Stop after first occurrence\n";
		print "-H               Produce histogram of calls rather than summary\n";
		print "-i               Says that function is an interrupt handler\n";
		print "--ignore <num>   Ignore the first <num> calls to the function\n";
		print "--max <num>      Stop after N occurrences\n";
		exit 0;
	}
	elsif (/^-m$/) {
		$mapfile = shift @ARGV;
	}
	elsif (/^-a$/) {
		$start_address = shift @ARGV;
		if ($start_address =~ /^[_a-z]/) {
			$named_start_address = $start_address;
			my $mapentry = `grep $start_address $mapfile`;
			my @fields = split / +/, $mapentry;
			$start_address = $fields[1];
		}
	}
	elsif (/^-l$/) {
		$list_subr = 1;
		$stop_after_one = 1;
	}
	elsif (/^--list-all$/) {
		$list_subr = 1;
	}
	elsif (/^-1$/) {
		$stop_after_one = 1;
	}
	elsif (/^-i$/) {
		$irq_flag = 1;
	}
	elsif (/^-H$/) {
		$histogram_flag = 1;
	}
	elsif (/^--ignore$/) {
		$ignored_calls = shift @ARGV;
	}
	elsif (/^--max$/) {
		$max_calls = shift @ARGV;
	}
	elsif (/^--compress$/) {
		$compress_flag = 1;
	}
	elsif (/^--decompress$/) {
		$decompress_flag = 1;
	}
}

if (!defined $start_address) {
	print "no start address given\n";
	exit 1;
}

sub start_call {
	if ($ignored_calls > 0) {
		$ignored_calls--;
		return 0;
	}
	$nested_subrs = 0;
	$start_time = $simulation_end_time;
	print "Start call:\n=====================================\n" if ($list_subr);
	return 1;
}

sub finish_call {
	my ($cycles) = @_;

	$histogram[$call_count] = $cycles;
	if ($histogram_flag) {
		print $cycles . "\n";
	}
	$call_count++;
	$max_duration = $cycles if ($cycles > $max_duration);
	$min_duration = $cycles if ($cycles < $min_duration);
	$total_cycles += $cycles;
	if ($call_count >= $max_calls) {
		print_report ();
		exit 0;
	}
	return 0;
}


sub print_report {
	$simulation_duration = $simulation_end_time - $system_ready_time;
	
	print "Function: " . ($named_start_address ? $named_start_address : $start_address) . "\n";


	if ($histogram_flag) {
		return;
	}

	if ($call_count == 0) {
		print "No calls.\n";
	}

	elsif ($call_count == 1) {
		print "Cycles: " . $total_cycles / $call_count . "\n";
	}

	elsif ($call_count > 1) {
		print "Number of calls: $call_count\n";
		print "Average cycles/call:  " . $total_cycles / $call_count . "\n";
		print "Min cycles/call: $min_duration\n";
		print "Max cycles/call: $max_duration\n";
		print "Length of simulation: $simulation_duration\n";
		print "Percentage of runtime: " .
			$total_cycles * 100 / $simulation_duration . "\n";
	}
}

#
# Begin main loop.
#
# Read each line from the trace file, parse it, and process it.
#
my $finish_flag = 0;
while (<>) {
	chomp;
	my $line = $_;
	next if ($line =~ /^$/);

	# With the decompress option, we first decode the compressed format
	# and make it look like the uncompressed format.
	if ($decompress_flag && $line =~ /([^#]*)#([0-9]+) (....) (.*)$/) {
		my ($regs, $timestamp_delta, $pc, $insn) = ($1, $2, $3, $4);
		$timestamp += $timestamp_delta;
		$line = "#$timestamp A:00 B:00 X:0000 Y:0000 U:0000 S:0000 $pc: $insn";
		if ($decompress_flag > 1) {
			print "$line\n";
			next;
		}
	}
	
	# Skip all trace entries until the 'system ready' pattern is found.
	# This is done by looking for when interrupts are turned on.
	# This ignores a lot of boot-time code that we don't care about.
	if (!$system_ready_time)
	{
		next unless ($line =~ /ANDCC.*#/);
		$line =~ /^#([0-9]+) /;
		$system_ready_time = $1;
	}

	# MAME tracing can produce shorter output when there are small loops
	# in the code.  If an 'rts' is omitted, this can confuse the tracer.
	if (($line =~ /loops/) && $inside) {
		print "warning: loop detected during function call; may not terminate correctly\n";
	}

	# Only consider lines that have tracing data.
	# The main items to parse here are the timestamp (cycle count) and the
	# current program counter.  The other registers are decoded but aren't
	# being used.
	if ($line =~ /^#([0-9]+) A:(..) B:(..) X:(....) Y:(....) U:(....) S:(....) (....): (.*)$/) {
		my ($timestamp, $areg, $breg, $xreg, $yreg, $ureg, $sreg, $pc, $insn) = 
			($1,         $2,    $3,    $4,    $5,    $6,    $7,    $8,  $9);
		$simulation_end_time = $timestamp;

		# In "compress" mode, just write a compressed version of the line.
		# This will keep the file much smaller.
		if ($compress_flag) {
			my $timestamp_delta = $timestamp - $previous_timestamp;
			my $dreg = $areg . $breg;
			$insn =~ s/ +/ /;

			print "D$dreg " if ($dreg ne $previous_dreg);
			print "X$xreg " if ($xreg ne $previous_xreg);
			print "Y$yreg " if ($yreg ne $previous_yreg);
			print "U$ureg " if ($ureg ne $previous_ureg);
			print "S$sreg " if ($sreg ne $previous_sreg);

			print "#$timestamp_delta $pc $insn\n";

			$previous_timestamp = $timestamp;
			$previous_dreg = $dreg;
			$previous_xreg = $xreg;
			$previous_yreg = $yreg;
			$previous_ureg = $ureg;
			$previous_sreg = $sreg;
			next;
		}

		# If end-of-function was detected on the previous instruction, then
		# finish the call here.  We defer this in order to account for the
		# time it takes to execute the final instruction.
		if ($finish_flag) {
			$inside = finish_call ($simulation_end_time - $start_time);
			$finish_flag = 0;
			last if ($stop_after_one && $call_count);
		}

		# If not inside the target function, see if this instruction starts it.
		# We can match an instruction pattern or an address.
		# Fallthrough to the next case so that the first instruction is handled.
		if (!$inside) {
			if ($line =~ /$start/) {
				$inside = start_call ();
			}
			elsif ($pc eq $start_address) {
				$inside = start_call ();
			}
		}

		# While inside the target function, print out the source code if
		# that is enabled, and check to see if we are at the end.
		if ($inside) {
			print "$line ($nested_subrs)\n" if ($list_subr);

			# The end-of-function can be an instruction pattern.
			if ($line =~ /$end/) {
				$inside = finish_call ($simulation_end_time - $start_time);
			}

			# Or it could be because of a return instruction.
			# However, due to nesting of functions, that alone is not enough.
			# We keep a nesting count and declare end-of-function only when the
			# call stack is empty.
			#
			# Return-from-interrupt is only processed when -i is given.
			elsif (($line =~ /PULS.*PC/) || ($line =~ /RTS/) ||
				(($line =~ /RTI/) && $irq_flag)) {
				if ($nested_subrs == 0) {
					$finish_flag = 1;
				} else {
					$nested_subrs--;
				}
			}

			# These instruction patterns say when a function is pushed onto
			# the call stack.
			elsif (($line =~ /JSR/) || ($line =~ /BSR/)) {
				$nested_subrs++;
			}
		}
	}
}
print_report ();

